home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / c / sas_c_emacs_b3.lha / sas-c.el < prev    next >
Lisp/Scheme  |  1994-03-28  |  9KB  |  291 lines
  1. ;;;
  2. ;;; FILE
  3. ;;;    sas-c.el V0.1
  4. ;;;
  5. ;;;    Copyright (C) 1993 by Anders Lindgren.
  6. ;;;
  7. ;;;    This file is NOT part of GNU Emacs.
  8. ;;;
  9. ;;; DISTRIBUTION
  10. ;;;    sas-c.el is free software; you can redistribute it and/or modify
  11. ;;;    it under the terms of the GNU General Public License as published 
  12. ;;;    by the Free Software Foundation; either version 1, or (at your 
  13. ;;;    option) any later version.
  14. ;;;
  15. ;;;    GNU Emacs is distributed in the hope that it will be useful,
  16. ;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;;    GNU General Public License for more details.
  19. ;;;
  20. ;;;    You should have received a copy of the GNU General Public
  21. ;;;    License along with GNU Emacs; see the file COPYING.  If not,
  22. ;;;    write to the Free Software Foundation, 675 Mass Ave, Cambridge,
  23. ;;;    MA 02139, USA.
  24. ;;;
  25. ;;; AUTHOR
  26. ;;;    Anders Lindgren, d91ali@csd.uu.se
  27. ;;;
  28. ;;; HISTORY
  29. ;;;    93-Mar-17 ALi * Created this file
  30. ;;;    93-Jun-09 ALi * Emacs now handles resultcodes from arexx-calls,
  31. ;;;            consequently, my old "bazoka" method were removed.
  32. ;;;    93-Jul-08 ALi * A typo in sas-c-scmsg-num fixed.
  33. ;;;            The delcomp-functions uncommented.
  34. ;;;    94-Mar-20 ALi * Sas/C 6.51 features added:
  35. ;;;            - next/prev doesn't wrap around.
  36. ;;;            - New class: "Note" without file and linenumber.
  37. ;;;            sas-c-scmsg now returns the returncode set by SCMSG.
  38. ;;;
  39.  
  40. (defvar sas-c-mode nil
  41.   "Variable indicating if the sas-c-mode is active.")
  42.  
  43. (defvar sas-c-compile-command "sc:c/smake"
  44.   "The command to run when the function sas-c-build is executed.")
  45.  
  46. (defun sas-c-mode (arg)
  47.   "Minor mode which enables Emacs to communicate with SCMSG,
  48. the error handler from SAS/C. If the function is called without args
  49. the mode is toggled, a positive integer switchen it on and a negative off.
  50.  
  51. The following keys are added to the current local map:
  52.  
  53. C-c C-a        Display the alternative file, if any.
  54. C-c C-c        Build a project accoring to sas-c-compile-command.
  55. C-c C-c        Build the project the same way the build icon does.
  56. C-c C-d        Delete the current message, and display next
  57. C-c C-h        Hide the SCMSG window.
  58. C-c C-l        Redisplay current message.
  59. C-c C-m        Build the project using smake
  60. C-c C-n        Display next error.
  61. C-c <down>    dito
  62. C-c C-p        Display previous error.
  63. C-c C-q        Remove all messages for a certain primary file.
  64. C-c C-s        Show the SCMSG window.
  65. C-c <up>    dito
  66. C-c <        Go to the first error message.
  67. C-c <sh. up>    dito
  68. C-c >        Go to the last error message.
  69. C-c <sh. down>    dito
  70.  
  71. When sas-c-mode is switched on, the hook sas-c-hook is called.
  72.  
  73. If a key shall be defined, the best way is to use a hook and the
  74. sas-c-define-key function. This way the keys are removed and the
  75. original values are restored when sas-c-mode is disabled.
  76.  
  77. For example:
  78.  (setq sas-c-mode-hook '(lambda ()
  79.             (sas-c-define-key \"\\C-ca\" 'your-favorite-fnk)
  80.             (sas-c-define-key \"\\C-cb\" 'another-function)
  81.             ))"
  82.   (interactive "P")
  83.   (make-local-variable 'sas-c-mode)
  84.   (make-local-variable 'sas-c-original-keys)
  85.   (let ((sas-c-mode-orig sas-c-mode))
  86.     (setq sas-c-mode
  87.       (if (null arg) (not sas-c-mode)
  88.         (> (prefix-numeric-value arg) 0)))
  89.     (or (assq 'sas-c-mode minor-mode-alist)
  90.     (setq minor-mode-alist
  91.           (cons '(sas-c-mode " SAS/C") minor-mode-alist)))
  92.     (cond ((and sas-c-mode (not sas-c-mode-orig))
  93.        ;; turning on sas-c-mode
  94.        (setq sas-c-original-keys '())
  95.        (sas-c-define-key "\C-c\C-a"      'sas-c-display-altfile)
  96.        (sas-c-define-key "\C-c\C-b"         'sas-c-build)
  97.        (sas-c-define-key "\C-c\C-c"         'sas-c-compile)
  98.        (sas-c-define-key "\C-c\C-d"      'sas-c-delete)
  99.        (sas-c-define-key "\C-c\C-h"      'sas-c-hide)
  100.        (sas-c-define-key "\C-c\C-l"      'sas-c-display-error)
  101.        (sas-c-define-key "\C-c\C-m"      'sas-c-make)
  102.        (sas-c-define-key "\C-c\C-n"      'sas-c-next)
  103.        (sas-c-define-key "\C-c\C-x\C-^B" 'sas-c-next)
  104.        (sas-c-define-key "\C-c\C-p"      'sas-c-prev)
  105.        (sas-c-define-key "\C-c\C-x\C-^A" 'sas-c-prev)
  106.        (sas-c-define-key "\C-c\C-q"      'sas-c-delcomp)
  107.        (sas-c-define-key "\C-c\C-Q"         'sas-c-delfile)
  108.        (sas-c-define-key "\C-c\C-s"      'sas-c-show)
  109.        (sas-c-define-key "\C-c<"         'sas-c-top)
  110.        (sas-c-define-key "\C-c\C-x\C-^T" 'sas-c-top)
  111.        (sas-c-define-key "\C-c>"         'sas-c-bottom)
  112.        (sas-c-define-key "\C-c\C-x\C-^S" 'sas-c-bottom)
  113.        (run-hooks 'sas-c-mode-hook))
  114.       ((and (not sas-c-mode) sas-c-mode-orig)
  115.        ;; turning off sas-c-mode
  116.        (sas-c-undef-keys)))))
  117.  
  118. (defun sas-c-define-key (key fnk)
  119.   "Make a keybinding which can be undone."
  120.   (setq sas-c-original-keys (cons (cons key (local-key-binding key)) 
  121.                   sas-c-original-keys))
  122.   (local-set-key key fnk))
  123.  
  124. (defun sas-c-undef-keys ()
  125.   "Unmake the keybindings made by sas-c-mode
  126. and restore the keys previous values."
  127.   (while sas-c-original-keys
  128.     (let ((fnk (cdr (car sas-c-original-keys)))
  129.       (key (car (car sas-c-original-keys))))
  130.       (if (numberp fnk)
  131.       (local-unset-key key)
  132.     (local-set-key key fnk)))
  133.     (setq sas-c-original-keys (cdr sas-c-original-keys))))
  134.  
  135. (defun sas-c-delete ()
  136.   "Delete the current error message and move to the next."
  137.   (interactive)
  138.   (sas-c-scmsg "delete")
  139.   (sas-c-display-error))
  140.  
  141. (defun sas-c-next ()
  142.   "Move to the nest error message."
  143.   (interactive)
  144.   (if (not (eq (sas-c-scmsg "next") 0))
  145.       (message "No more messages")
  146.     (sas-c-display-error)))
  147.  
  148. (defun sas-c-prev ()
  149.   "Move to the prevous error message."
  150.   (interactive)
  151.   (if (not (eq (sas-c-scmsg "prev") 0))
  152.       (message "No more messages")
  153.     (sas-c-display-error)))
  154.  
  155. (defun sas-c-top ()
  156.   "Move to the first error message."
  157.   (interactive)
  158.   (sas-c-scmsg "top")
  159.   (sas-c-display-error))
  160.  
  161. (defun sas-c-bottom ()
  162.   "Move to the last error message."
  163.   (interactive)
  164.   (sas-c-scmsg "bottom")
  165.   (sas-c-display-error))
  166.  
  167. (defun sas-c-delcomp-current ()
  168.   "Delete all messages for the primary file of the current error."
  169.   (sas-c-scmsg "delcomp"))
  170.  
  171. (defun sas-c-delcomp (filename)
  172.   "Delete all messages with the specified filename as primary filename."
  173.   (interactive "fFilename (Press return for current file): ")
  174.   (sas-c-scmsg (format "delcomp \"%s\"" filename)))
  175.  
  176. (defun sas-c-delfile-current ()
  177.   "Delete all messages for the secondary file of the current error."
  178.   (sas-c-scmsg "delfile"))
  179.  
  180. (defun sas-c-delfile (filename)
  181.   "Delete all messages with the specified filename as secondary filename."
  182.   (interactive "fFilename (Press return for current file): ")
  183.   (sas-c-scmsg (format "delfile \"%\"s" filename)))
  184.  
  185. (defun sas-c-show (& optional arg)
  186.   "Show the scmsg window.
  187. If called with arguments the window gets unactivated."
  188.   (interactive "P")
  189.   (sas-c-scmsg (if arg "show" "show activate")))
  190.  
  191. (defun sas-c-hide ()
  192.   "Show the scmsg window."
  193.   (interactive)
  194.   (sas-c-scmsg "hide"))
  195.  
  196. (defun sas-c-compile ()
  197.   "Build with SAS/C. The command in sas-c-compile-command is executed
  198. and the output is places in the buffer *compilation*"
  199.   (interactive)
  200.   (compile sas-c-compile-command))
  201.  
  202. (defun sas-c-build ()
  203.   "Build the project the same way the build icon does"
  204.   (interactive)
  205.   (compile "sc:c/sc BUILDPROJECT"))
  206.  
  207. (defun sas-c-make ()
  208.   "Build the project using smake"
  209.   (interactive)
  210.   (compile "sc:c/smake"))
  211.   
  212.  
  213. (defun sas-c-display-error ()
  214. "Display the current error in SCMSG."
  215.   (interactive)
  216.   (let ((class (sas-c-scmsg-str "class")))
  217.     (if (equal class "")
  218.     (message "No error to display")
  219.       (if (equal class "Note")
  220.       (sas-c-view-note    (sas-c-scmsg-str "text"))
  221.       (sas-c-view-message (sas-c-scmsg-str "file")
  222.                   (sas-c-scmsg-num "line")
  223.                   (sas-c-scmsg-str "text")
  224.                   class
  225.                   (sas-c-scmsg-str "errnum"))))))
  226.  
  227. (defun sas-c-display-altfile ()
  228. "Display the secondary file. (Same as C-u sas-c-display-error.)"
  229.   (interactive)
  230.   (let ((file (sas-c-scmsg-str "altfile")))
  231.     (if (equal file "")
  232.     (message "No alternate file")
  233.       (sas-c-view-message file 
  234.               (sas-c-scmsg-num "altline")
  235.               (sas-c-scmsg-str "text")
  236.               (sas-c-scmsg-str "class")
  237.               (sas-c-scmsg-str "errnum")))))
  238.  
  239. (defun sas-c-view-message (file line text class errnum)
  240.   (if (equal file "")
  241.       ()
  242.     (sas-c-get-file file)
  243.     (set-mark (point))
  244.     (goto-line line))
  245.   (let ((isalt (string-match "; See line [0-9]* file \".*\"" text)))
  246.     (if isalt (setq text (substring text 0 isalt)))
  247.     (message (format "%s %s%s: %s" class 
  248.                            errnum 
  249.                    (if isalt " (Alt)" "") 
  250.                    text))))
  251.  
  252. (defun sas-c-view-note (text)
  253.   (message (format "Note: %s" text)))
  254.  
  255. (defun sas-c-get-file (file)
  256.   "Get the file requested into a visiable buffer."
  257.   (let ((buf (get-file-buffer file)))
  258.     (if buf
  259.     (let ((win (get-buffer-window buf)))
  260.       (if win
  261.           (select-window win)
  262.         (switch-to-buffer buf)))
  263.       (find-file file))))
  264.  
  265. ;;;
  266. ;;; Low level ARexx communication routines.
  267. ;;;  
  268.  
  269. (defun sas-c-scmsg (command)
  270.   "Sends a command to SCMSG.
  271. Returns the returncode set by SCMSG"
  272.   (string-to-int (amiga-arexx-do-command
  273.           (concat "address 'SC_SCMSG' '" command "'; exit rc") 
  274.           t)))
  275.  
  276. (defun sas-c-scmsg-str (command)
  277.   "Sends a command to SCMSG and returns the result string."
  278.   (amiga-arexx-do-command
  279.     (concat "options results; address 'SC_SCMSG' '"
  280.         command
  281.         "'; return result")
  282.     t))
  283.  
  284. (defun sas-c-scmsg-num (command)
  285.   "Sends a command to SCMSG and returns the resulting number."
  286.   (string-to-int (amiga-arexx-do-command
  287.           (concat "options results; address 'SC_SCMSG' '"
  288.               command
  289.               "'; return result")
  290.           t)))
  291.